/* -*- mode: C; mode: fold; -*- */

/*
 * SLIRP: The (Sl)ang (I)nte(r)face (P)ackage is a code generator,
 * like S.W.I.G. for S-Lang.
 *
 * Copyright (C) 2003 Massachusetts Institute of Technology 
 * Copyright (C) 2002 Michael S. Noble <mnoble@space.mit.edu>
 *
 * This software was partially developed by the MIT Center for Space
 * Research under contract SV1-61010 from the Smithsonian Institution.
 * 
 * Permission to use, copy, modify, distribute, and sell this software
 * and its documentation for any purpose is hereby granted without fee,
 * provided that the above copyright notice appear in all copies and
 * that both that copyright notice and this permission notice appear in
 * the supporting documentation, and that the name of the Massachusetts
 * Institute of Technology not be used in advertising or publicity
 * pertaining to distribution of the software without specific, written
 * prior permission.  The Massachusetts Institute of Technology makes
 * no representations about the suitability of this software for any
 * purpose.  It is provided "as is" without express or implied warranty.
 * 
 * THE MASSACHUSETTS INSTITUTE OF TECHNOLOGY DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS.  IN NO EVENT SHALL THE MASSACHUSETTS
 * INSTITUTE OF TECHNOLOGY BE LIABLE FOR ANY SPECIAL, INDIRECT OR
 * CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
 * OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
 * NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION
 * WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 */


/* This file contains a module initialization fragment.
 * Content delimited by leading and trailing underscores
 * (in the template) is replaced prior to compilation */

#include <stdlib.h>
#include "slang.h"

#include "glade.h"
#include "glade-init.h"
#include "glade-xml.h"


#define   MODULE_HAS_OPAQUE_TYPE	23

#ifndef   MODULE_HAS_INTEGER_CONSTANTS
#define   MODULE_HAS_INTEGER_CONSTANTS	0
#endif

#ifndef   MODULE_HAS_DOUBLE_CONSTANTS
#define   MODULE_HAS_DOUBLE_CONSTANTS	0
#endif

#ifndef   MODULE_HAS_STRING_CONSTANTS
#define	  MODULE_HAS_STRING_CONSTANTS	0
#endif

#include "slirptypes.h"

unsigned char   map_scalars_to_refs = 0;

#if MODULE_HAS_INTEGER_CONSTANTS
static SLang_IConstant_Type glade_IConsts [] = 
{

#include "glade_iconsts.c"

  SLANG_END_ICONST_TABLE
};
#endif

#if MODULE_HAS_DOUBLE_CONSTANTS
static SLang_DConstant_Type glade_DConsts [] = 
{

#include "glade_dconsts.c"

  SLANG_END_DCONST_TABLE
};
#endif


#if MODULE_HAS_STRING_CONSTANTS
#include "glade_strings.c"

static SLang_Intrin_Var_Type glade_IVars[] =
{

#include "glade_strconsts.c"

  SLANG_END_INTRIN_VAR_TABLE
};
#endif


static int pop_array_or_ref(int type, void *pv, Slirp_Ref *sref)
{
   unsigned int objtype = SLang_peek_at_stack();

   switch(objtype) {

	case SLANG_ARRAY_TYPE:
	   if (SLang_pop_array_of_type(&sref->array,type) == -1)
		return -1;

           sref->ref = NULL;
	   sref->data = sref->array->data;
	   break;

	case SLANG_REF_TYPE:
	   if (SLang_pop_ref(&sref->ref) == -1)
		return -1;
	   sref->array = NULL;
	   sref->data = pv;
	   break;

	case SLANG_CHAR_TYPE:		/* treat scalar instances of basic */
	case SLANG_UCHAR_TYPE:		/* types as 1-elementn arrays      */
	case SLANG_SHORT_TYPE:
	case SLANG_USHORT_TYPE:
	case SLANG_INT_TYPE:
	case SLANG_UINT_TYPE:
	case SLANG_LONG_TYPE:
	case SLANG_ULONG_TYPE:
	case SLANG_FLOAT_TYPE:
	case SLANG_DOUBLE_TYPE:

	{
	   /* Accomodate FORTRAN pass by reference semantics */

           sref->ref = NULL;
	   if (map_scalars_to_refs && 
		 	SLang_pop_array_of_type(&sref->array,type) == 0) {

           	memcpy(pv,sref->array->data,(size_t)sref->array->sizeof_type);
		sref->data = pv;
		break;
	   }
	}
	   /* intentional fallthrough */

	default:

	   SLang_verror(SL_INTRINSIC_ERROR, "input argument is not an array");
	   return -1;
   }

   return 0;
}

#include "glade_init.h"
#include "glade_glue.c"

static SLang_Intrin_Fun_Type glade_Intrin_Funcs[] =
{
#include "glade_ftable.c"
  SLANG_END_INTRIN_FUN_TABLE
};

#include "slirptypes.c"

SLANG_MODULE(glade);
int init_glade_module_ns(char *ns_name)
{
   SLang_NameSpace_Type *ns = NULL;

   if (ns_name != NULL) {
	ns = SLns_create_namespace (ns_name);
	if (ns == NULL)
	   return -1;
   }

#if MODULE_HAS_OPAQUE_TYPE
   if (allocate_glade_opaque_types() == -1)
            return -1;
#endif


#if MODULE_HAS_INTEGER_CONSTANTS
   if (-1 == SLns_add_iconstant_table (ns, glade_IConsts, NULL))
	return -1;
#endif


#if MODULE_HAS_DOUBLE_CONSTANTS
   if (-1 == SLns_add_dconstant_table (ns, glade_DConsts, NULL))
	return -1;
#endif


#if MODULE_HAS_STRING_CONSTANTS
   if (-1 == SLns_add_intrin_var_table (ns, glade_IVars, NULL))
	return -1;
#endif


   if (-1 == SLns_add_intrin_fun_table (ns, glade_Intrin_Funcs,
	    						"__glade__"))
	return -1;

   return 0;
}
